home *** CD-ROM | disk | FTP | other *** search
/ IRIS Performer 2.2 Friends Demo / SGI IRIS Performer 2.2 Friends Demo.iso / friends / openworlds / tix / DragDrop.tcl < prev    next >
Text File  |  1997-11-22  |  4KB  |  164 lines
  1. # DragDrop.tcl ---
  2. #
  3. #    Implements drag+drop for Tix widgets.
  4. #
  5. #
  6. #
  7. # Copyright (c) 1994-1995 Ioi Kim Lam. All rights reserved.
  8. #
  9. # See the file "license.terms" for information on usage and redistribution
  10. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11. #
  12.  
  13. tixClass tixDragDropContext {
  14.     -superclass {}
  15.     -classname  TixDragDropContext
  16.     -method {
  17.     cget configure drag drop set startdrag
  18.     }
  19.     -flag {
  20.     -command -source
  21.     }
  22.     -configspec {
  23.     {-command {}}
  24.     {-source {}}
  25.     }
  26. }
  27.  
  28. proc tixDragDropContext::Constructor {w} {
  29.     upvar #0 $w data
  30. }
  31.  
  32. #----------------------------------------------------------------------
  33. # Private methods
  34. #
  35. #----------------------------------------------------------------------
  36. proc tixDragDropContext::CallCommand {w target command X Y} {
  37.     upvar #0 $w data
  38.      
  39.     set x [expr $X-[winfo rootx $target]]
  40.     set y [expr $Y-[winfo rooty $target]]
  41.     
  42.     regsub %x $command $x command
  43.     regsub %y $command $y command
  44.     regsub %X $command $X command
  45.     regsub %Y $command $Y command
  46.     regsub %W $command $target command
  47.     regsub %S $command [list $data(-command)] command
  48.  
  49.     eval $command
  50. }
  51.  
  52. proc tixDragDropContext::Send {w target event X Y} {
  53.     upvar #0 $w data
  54.     global tixDrop
  55.  
  56.     foreach tag [tixDropBindTags $target] {
  57.     if [info exists tixDrop($tag,$event)] {
  58.         tixDragDropContext::CallCommand $w $target \
  59.         $tixDrop($tag,$event) $X $Y
  60.     }
  61.     }
  62. }
  63.  
  64. #----------------------------------------------------------------------
  65. # set --
  66. #
  67. #    Set the "small data" of the type supported by the source widget
  68. #----------------------------------------------------------------------
  69.  
  70. proc tixDragDropContext::set {w type data} {
  71.  
  72. }
  73.  
  74. #----------------------------------------------------------------------
  75. # startdrag --
  76. #
  77. #    Start the dragging action
  78. #----------------------------------------------------------------------
  79. proc tixDragDropContext::startdrag {w x y} {
  80.     upvar #0 $w data
  81.  
  82.     set data(oldTarget) {}
  83.  
  84.     $data(-source) config -cursor "[tix getbitmap drop] black"
  85.     tixDragDropContext::drag $w $x $y
  86. }
  87.  
  88. #----------------------------------------------------------------------
  89. # drag --
  90. #
  91. #    Continue the dragging action
  92. #----------------------------------------------------------------------
  93. proc tixDragDropContext::drag {w X Y} {
  94.     upvar #0 $w data
  95.     global tixDrop
  96.  
  97.     set target [winfo containing $X $Y]
  98.  
  99.     if {$target != $data(oldTarget)} {
  100.     if {$data(oldTarget) != {}} {
  101.         tixDragDropContext::Send $w $data(oldTarget) <Out> $X $Y 
  102.     }
  103.     if {$target != {}} {
  104.         tixDragDropContext::Send $w $target <In> $X $Y
  105.     }
  106.     set data(oldTarget) $target
  107.     }
  108.     if {$target != {}} {
  109.     tixDragDropContext::Send $w $target <Over> $X $Y
  110.     }
  111. }
  112.  
  113. proc tixDragDropContext::drop {w X Y} {
  114.     upvar #0 $w data
  115.     global tixDrop
  116.  
  117.     set target [winfo containing $X $Y]
  118.     if {$target != {}} {
  119.     tixDragDropContext::Send $w $target <Drop> $X $Y
  120.     }
  121.  
  122.     if {$data(-source) != {}} {
  123.     $data(-source) config -cursor {}
  124.     }
  125.     set data(-source) {}
  126. }
  127.  
  128. #----------------------------------------------------------------------
  129. # Public Procedures -- This is NOT a member of the tixDragDropContext
  130. #               class!
  131. #
  132. # parameters :
  133. #    $w:    who wants to start dragging? (currently ignored)
  134. #----------------------------------------------------------------------
  135. proc tixGetDragDropContext {w} {
  136.     global tixDD
  137.     if {[info exists tixDD]} {
  138.     return tixDD
  139.     }
  140.  
  141.     return [tixDragDropContext tixDD]
  142. }
  143.  
  144. proc tixDropBind {w event command} {
  145.     global tixDrop
  146.  
  147.     set tixDrop($w) 1
  148.     set tixDrop($w,$event) $command
  149. }
  150.  
  151. proc tixDropBindTags {w args} {
  152.     global tixDropTags
  153.  
  154.     if {$args == {}} {
  155.     if [info exists tixDropTags($w)] {
  156.         return $tixDropTags($w)
  157.     } else {
  158.         return [list [winfo class $w] $w]
  159.     }
  160.     } else {
  161.     set tixDropTags($w) $args
  162.     }
  163. }
  164.